perm filename FIX.SAI[X,ALS]1 blob
sn#075315 filedate 1973-12-04 generic text, type T, neo UTF8
00010 BEGIN "FIX"
00020 DEFINE ⊂="COMMENT"; ⊂ NOV.26,1973;
00025 ⊂ The initial program to prepare files of input parameters obtained
00027 pulse synchronously from the acoustic files and to convert header
00028 information into this same form;
00040 DEFINE ⊃="⊂";
00050 DEFINE CR="'15",LF="'12",CRLF="CR&LF",TB="'11";
00060 REQUIRE "DPYSUB.HDR[1,PDQ]" SOURCE_FILE;
00070 LABEL STARTP,STOPP,TOFORM;
00080 DEFINE \=" "; ⊂ DEFINE \="SAFE"; ⊂ Alternarte definitions;
00090 ⊂ REQUIRE "LPC2[X,ALS]" LOAD_MODULE;
00095 ⊂ require "PREPAR[X,ALS]" LOAD_MODULE;
00100 FORTRAN REAL PROCEDURE SQRT(REAL X);
00110 FORTRAN REAL PROCEDURE ALOG10(REAL X);
00120 FORTRAN REAL PROCEDURE COS(REAL X);
00130 FORTRAN REAL PROCEDURE SIN(REAL X);
00140 INTEGER ZEROC,ZEROF,DX;
00150 ⊂ EXTERNAL FORTRAN PROCEDURE LPC1(REFERENCE REAL A,B,R0,C;⊂ REFERENCE INTEGER N,I,J);
00160 REQUIRE "F[X,ALS]" LOAD_MODULE;
00170 EXTERNAL FORTRAN PROCEDURE FRXFM
00180 (REFERENCE INTEGER M;REFERENCE REAL X,Y);
00185 ⊂ EXTERNAL PROCEDURE PREPARE;
00190 \ INTERNAL REAL ARRAY A,B,C,D[0:512];
00200 REAL X,SX; \ REAL ARRAY WINDOW[0:512];
00210 INTERNAL REAL R0;
00220 INTEGER LPCOPT;
00230 \ INTEGER ARRAY DPYBUF[0:1535];
00240 \ INTEGER ARRAY LFILE[0:'177];
00250 \ INTEGER ARRAY SYMBOL[0:127];
00260 \ INTEGER ARRAY DAT,AVDAT[0:23];
00270 \ INTEGER ARRAY FVAL[0:8];
00275 \ INTEGER ARRAY NEW[0:512];
00276 \ INTEGER ARRAY PFFT[0:64]; INTEGER SIZE;
00277 INTEGER NX;
00280 INTEGER FX;
00290 STRING ARRAY SAMPLE[0:127];
00300 INTEGER I,J,K,L,P,PP,Q,QQ,R,DK,DDK,DDDK,DVAL,DDVAL,DDDVAL,
00310 POINTX,STATE,DELTA,VAL,CHAN1,EOF,POINTT,POINTV;
00320 INTERNAL INTEGER M,N;
00330 INTEGER PT0,PT1,PT2,X0,X1,Y0,Y1,X2,Y2,
00340 PTCNT,PICK,JP,JPX,OPT,OPT1,SHUFCT;
00350 INTEGER II,JJ,KK,NN,SEGC,BRK,EOFA,EOFT,EOFTF,READ3,LFX,
00360 SEGTOT,SEGIN,KKT,NNT,ITT,JTT,KTT;
00370 BOOLEAN ER;
00380 INTEGER CHAN2,CHAN3,CHAN4,CHAN5,CHAN6,CHANX;
00390 \ INTEGER ARRAY BUF,BUFT,BUFTT[0:511];
00400 STRING FILEN,READ,READ1,READT,READTT,FILEO,READ2,FILEQ,TFILE,FILLST,FILEP;
00410
00420 PROCEDURE OUTALL(STRING S);
00430 BEGIN
00440 STRING SS; INTEGER J;
00450 SETBREAK(18,0,NULL,"OSN");
00460 SS←SCAN(S,18,J);
00470 OUTSTR(SS);
00480 END;
00490
00500 PROCEDURE DATAIN;
00510 BEGIN
00520 INTEGER J;
00530 FOR J←0 STEP 1 UNTIL 511 DO BUF[J]←0;
00535 ⊂ IF EOF=0 THEN OUTSTR("BUF") ELSE OUTSTR(" EOF ");
00540 IF EOF=0 THEN ARRYIN(CHAN1,BUF[0],512);
00555 ⊂ IF EOF=0 THEN OUTSTR(" New BUF ") ELSE OUTSTR(" EOF ");
00570 POINTX←POINT(12,BUF[0],-1);
00580 SEGC←II←II+12; JJ←II+11;
00590 END;
00600
00710
00720 PROCEDURE DTTTIN;
00730 BEGIN
00740 INTEGER J;
00750 IF EOFT=0 THEN ARRYIN(CHAN3,BUFTT[0],512)
00760 ELSE OUTSTR
00770 ("No more .P data with JJ= "&CVS(JJ)&"SEGC= "&CVS(SEGC)&CRLF);
00780 FOR J←0 STEP 1 UNTIL 511 DO IF BUFTT[J]=0 THEN BUFTT[J]←'377777777777;
00790 ITT←BUFTT[0] LSH -15; KTT←0; JTT←BUFTT[511] LSH -15;
00800 ⊂ FOR J←0 STEP 1 UNTIL 10 DO OUTSTR(CVOS(BUFTT[J])&TB);
00810 END;
00820
02070
02080 PROCEDURE RARDIS;
02090 BEGIN
02100 INTEGER I,J,K,SP;
02110 INTEGER LY,DY;
02120 REAL MAX,MIN;
02130
02140
02150 MAX←-1000.;MIN←10000.;
02160 FOR I←0 STEP 1 UNTIL 256 DO IF C[I]>MAX THEN MAX←C[I];
02170 SP←6; COMMENT HORIZONTAL SPACING;
02180 FOR I←0 STEP 1 UNTIL 256 DO BEGIN
02190 C[I]←5.5*(C[I]+48-MAX); IF C[I]<0 THEN C[I]←0; END;
02210
02220
02230 RIVECT(35,130);
02240
02250 SETFORMAT(1,0);
02260 ⊂ Write horizantal numbers;
02270 FOR I←0 STEP 1 UNTIL 5 DO BEGIN
02280 DPYSST(CVS(I)); RIVECT(139,0); END; RIVECT(-139,0);
02290 FOR I←6 STEP 1 UNTIL 10 DO BEGIN
02300 RIVECT(36,0); DPYSST(CVS(I)); END; RIVECT(-22,-5);
02310 RIVECT(-512,0); RIVECT(-512,0);
02320
02330 rivect(-1,0); ⊂ Start with 1 off so total will be correct;
02340 ⊂ Draw scale to 5000, with 50 markers to 770;
02350 FOR I←1 STEP 1 UNTIL 5 DO BEGIN
02360 FOR J←1 STEP 1 UNTIL 2 DO BEGIN
02370 FOR K←1 STEP 1 UNTIL 2 DO BEGIN
02380 RIVECT(15,0); RIVECT(0,-10); RVECT(0,10);
02390 RIVECT(16,0); RIVECT(0,-10); RVECT(0,10); END;
02400 RIVECT(15,0); RIVECT(0,-50); RVECT(0,50); END;
02410 RIVECT(0,-264); RVECT(0,264); END;
02420
02430 ⊂ Draw scale from 5000 to 10,000, with 25 markers to 255;
02440 FOR I←1 STEP 1 UNTIL 5 DO BEGIN
02450 FOR J←1 STEP 1 UNTIL 4 DO BEGIN
02460 RIVECT(10,0); RIVECT(0,-10); RVECT(0,10); END;
02470 RIVECT(11,0); RIVECT(0,-264); RVECT(0,264); END;
02480 RVECT(-512,0); RVECT(-512,0);
02490
02500 SETFORMAT(2,0);
02510 ⊂ Vertical numbers and vertical scale;
02520 FOR I←0 STEP 12 UNTIL 42 DO BEGIN
02530 RIVECT(-35,-7); DPYSST(CVS(I)); RIVECT(15,7);
02540 RVECT(-10,0); RIVECT(0,-33);
02550 RIVECT(-35,-7); DPYSST(CVS(I+6)); RIVECT(10,7);
02560 RVECT(-5,0);RIVECT(0,-33); END;
02570 RIVECT(0,264); RVECT(0,-264);
02580 RIVECT(-35,-7); DPYSST(CVS(I)); RIVECT(5,7);
02590 RVECT(512,0); RVECT(512,0); RIVECT(-512,0); RIVECT(-512,0);
02600
02610 LY←C[0]; RIVECT(0,LY);
02620 FOR I←1 STEP 1 UNTIL 128 DO
02630 BEGIN
02640 DY←C[I]-LY;
02650 LY←LY+DY;
02660 RVECT(SP,DY);
02670 END;
02680 SP←2;
02690 FOR I←129 STEP 1 UNTIL 256 DO
02700 BEGIN
02710 DY←C[I]-LY;
02720 LY←LY+DY;
02730 RVECT(SP,DY);
02740 END;
02750 RIVECT(0,108-LY);
02755 DPYOUT(0); PTOCHW(0,'10120);
02760 END "RARDIS";
02770
03070
03080 INTERNAL PROCEDURE FORM(INTEGER LPCOPT);
03090 BEGIN "FORM"
03100 REAL ERRN,ERR;
03110 INTEGER I,J;
03120 M←9; N←2↑M; DEFINE PI="3.141592653";
03130 IF FX=0 THEN
03140 FOR I←0 STEP 1 UNTIL N DO WINDOW[I]←(1-COS((2*PI*I)/N))/2
03150
03160 ELSE BEGIN N←FVAL[FX+1]-FVAL[FX]; J←0;
03170 FOR I←0 STEP 1 UNTIL FVAL[FX] DO WINDOW[I]←0;
03180 FOR I←FVAL[FX] STEP 1 UNTIL FVAL[FX+1] DO BEGIN
03190 WINDOW[I]←(1-COS((2*PI*J)/N))/2; J←J+1; END;
03200 FOR I←FVAL[FX+1] STEP 1 UNTIL 512 DO WINDOW[I]←0; END;
03210 FOR I←0 STEP 1 UNTIL 512 DO A[I]←D[I];
03220
03230 IF LPCOPT=0 THEN BEGIN "LPC"
03240 FOR I←0 STEP 1 UNTIL N-2 DO A[I]←(A[I+1]-A[I])*WINDOW[I];
03250 ⊂ LOADS DATA IN A, DIFFERENTIATES AND WINDOWS ;
03260 I←24; J←N%2;
03270 ⊂ LPC1(A[0],B[0],R0,C[0],N,I,J);
03280 END "LPC" ELSE
03290
03300 BEGIN "FFT"
03310 FOR I←0 STEP 1 UNTIL 512 DO BEGIN
03320 A[I]←D[I]*WINDOW[I]; B[I]←0;
03330 ⊃ SETFORMAT(10,3); ⊃ OUTSTR(CVS(I)&TB&CVG(D[I])&TB&CVG(A[I])&CRLF);
03340 END;
03350 FRXFM(M,A[0],B[0]);
03360 ⊃ OUTSTR("FFT COMPLETE"&CRLF);
03365 J←0;
03370 FOR I←0 STEP 1 UNTIL 256 DO BEGIN
03380 X←A[I]↑2+B[I]↑2+1.*10↑-37;
03385 IF X>J THEN J←X;
03390 ⊃ OUTSTR(CVG(A[I])&" "&CVG(B[I])&" "&CVG(X)&TB);
03400 C[I]←10.*ALOG10(X); END;
03405 ⊂ IF J%N>SIZE THEN BEGIN SIZE←J%N;
03407 ⊂ OUTSTR("SIZE="&CVS(SIZE%256)&CRLF); ⊂ END;
03410 END "FFT";
03420
03440 END "FORM";
03450
03460 PROCEDURE MARK;
03470 BEGIN "MARK"
03480 INTEGER I,JJ,K,L,JJP,LP,PT2;
03490
03530 RIVECT(0,-130); SETFORMAT(3,0);
03540 FOR I←0 STEP 20 UNTIL 340 DO BEGIN
03550 DPYSST(CVS(I)); RIVECT(15,0); END;
03560 RIVECT(-555,30); RIVECT(-500,0);
03570
03580 FOR I←0 STEP 100 UNTIL 300 DO BEGIN "HUNDRED"
03590 RIVECT(0,30); RVECT(0,-30);
03600 FOR JJ←0 STEP 50 UNTIL 50 DO BEGIN "FIFTY"
03610 FOR K←1 STEP 1 UNTIL 5 DO BEGIN "TEN"
03620 RIVECT(15,0); RVECT(0,5); RIVECT(0,-5);
03630 RIVECT(15,0); RVECT(0,10);RIVECT(0,-10);
03640 END "TEN";
03650 RVECT(0,20); RIVECT(0,-20);
03660 IF I≥300 THEN DONE "HUNDRED";
03670 END "FIFTY";
03680 END "HUNDRED";
03690 RIVECT(-550,100); RIVECT(-500,0);
03700
03710 K←D[0]%8; RIVECT(0,K);
03720 FOR I←1 STEP 1 UNTIL 350 DO BEGIN
03730 JJP←D[I]%8;
03740 LP←JJP-K; RVECT(3,LP); K←JJP; END;
03750 RIVECT(-550,-K); RIVECT(-500,0);
03760
03820 RIVECT(500,0);
03830 FOR JJ←1 STEP 1 UNTIL 2 DO BEGIN
03840 L←3*FVAL[JJ]-500;
03850 RIVECT(L,100); RVECT(0,-100); RIVECT(-25,0); RVECT(50,0);
03860 RIVECT(-25,0); RVECT(0,-100); RIVECT(-L,100); END;
03870 RIVECT(-500,0);
03880 DPYOUT(0); PTOCHW(0,'10120);
04020
04030 END "MARK";
04040
04050 INTERNAL PROCEDURE CALCOMP(STRING FILE;INTEGER ARRAY BUFR);
04060 ⊃ Outputs display buffer BUFR to disk file FILE in a format
04070 readable by the Nealy Calcomp plotter program PLTVEC, and by
04080 the Quam Video Synthesizer program MIRTOP;
04090 IF FILE THEN
04100 BEGIN INTEGER DSIZ,CCCHN;
04110 OPEN(CCCHN←GETCHAN,"DSK",'14,0,1,0,0,0);
04120 ENTER(CCCHN,FILEN&".GRF",0);
04140 DPYPARS;DSIZ←BUFR[1]+4;
04160 ARRYOUT(CCCHN,BUFR[0],2);WORDOUT(CCCHN,0);
04170 ARRYOUT(CCCHN,BUFR[2],DSIZ-2);
04180 RELEASE(CCCHN);
04190 END "CALCOMP";
00010 FILEN←"HI20.001[CMP,JH]";
00020 FILEO←"SEG1.FRI";
00030 ⊂ HEADIN;
00040 STDBRK(1);
00050 SETBREAK(14,"∃",NULL,"INS");
00060 SETBREAK(15,'11&'12&'14&'15&'40,NULL,"INS");
00070 SETBREAK(16,'56,NULL,"INA");
00080 SETBREAK(17,'12,'15,"INS");
00090
00100 CHAN1←1; CHAN2←2; CHAN3←3; CHAN4←4; CHAN5←5; CHAN6←6;
00110 OUTSTR("This program generates files in the new format containing header"&
00120 " information"&CRLF&
00130 " and pulse synchronous parameters for each pulse period, packed 4 to"&
00140 " word."&CRLF&LF);
00150
00160 OUTSTR("At present this program takes acoustic data from [CMP,JH],"&
00170 CRLF&tb&"indentifying information from MAP.PHM[11,ALS]"&CRLF&
00180 TB&"pulse informstion from .P[PIT,NJM] files"&CRLF&TB&
00190 "and header information from files .T0X[11,ALS]."&CRLF&LF);
00200 outstr("It creates files .SYN[SYN,ALS]."&CRLF);
00210
00220 CLOSE(CHAN4); OPEN(CHAN4,"DSK",1,2,0,3500,BRK,EOFA);
00230 LOOKUP(CHAN4,"MAP.PHN[11,ALS]",ER);
00240 WHILE ER DO BEGIN OUTSTR(CRLF&"Can't find MAP.PHN[11,ALS]. File = ");
00250 LOOKUP(CHAN4,TFILE←INCHWL,ER); END; EOFA←0;
00260 FILLST←INPUT(CHAN4,14);
00270 CLOSE(CHAN4);
00280
00290 FOR I←0 STEP 1 UNTIL 127 DO BEGIN
00300 WHILE TRUE DO BEGIN
00310 READ1←SCAN(FILLST,17,K);
00320 READ3←READ1[1 TO 1];
00330 IF READ3≠"⊂" THEN DONE; END;
00340 IF READ3="" THEN DONE;
00350 SYMBOL[I]←CVASC(SCAN(READ1,15,K));
00360 SAMPLE[I]←READ1; END;
00370
00380 STARTP:
00390
00400 OUTSTR(CRLF&"Type number of file to start (CR only for 1) ");
00410 IF (READ←INCHWL)="" THEN PP←1 ELSE PP←CVD(READ);
00420
00430 ⊂ Begin FILEREAD;
00440 FOR PP←PP STEP 1 UNTIL 26 DO BEGIN "FILEREAD"
00450 CLOSE(CHAN1); OPEN(CHAN1,"DSK",'10,10,0,0,0,EOF);
00460 SETFORMAT(-3,0); FILEQ←CVS(PP);
00470 FILEN←FILEN[1 TO 5]&FILEQ&"[CMP,JH]";
00480 LOOKUP(CHAN1,FILEN,ER); TFILE←FILEN;
00490 WHILE ER DO BEGIN
00500 IF PP>1 THEN BEGIN OUTSTR("Out of data, will terminate."&CRLF);
00510 GOTO STOPP; END;
00520 OUTSTR(CRLF&"Can not find file "&TFILE&" File= ");
00530 LOOKUP(CHAN1,TFILE←INCHWL,ER); END;
00540 J←K←L←STATE←VAL←0; R←-1;
00550 SETFORMAT(1,0); FILEQ←CVS(PP); JP←1000; R←-1; CLRBUF;
00560 II←-11; JJ←-1;
00570
00580 DATAIN;
00590 FOR J←0 STEP 1 UNTIL 511 DO BEGIN
00600 VAL←ILDB(POINTX); IF VAL>2047 THEN VAL←VAL-4096; D[J]←VAL; END;
00610 SEGIN←4; FVAL[1]←FVAL[2]←0;
00620
00630 READT←FILEO[1 TO 3]&FILEQ&".T0X[11,ALS]";
00640 CLOSE(CHAN2); OPEN(CHAN2,"DSK",'10,10,0,0,0,EOFA);
00650 LOOKUP(CHAN2,READT,ER); TFILE←READT;
00660 WHILE ER DO BEGIN
00670 IF PP>1 THEN BEGIN OUTSTR("Out of data, will start over."&CRLF);
00680 GOTO STARTP; END;
00690 OUTSTR(CRLF&"Can not find file "&TFILE&" File= ");
00700 LOOKUP(CHAN2,TFILE←INCHWL,ER); END;
00710 ARRYIN(CHAN2,LFILE[0],'200); ⊂ Input header;
00720 LFX←21; CLOSE(CHAN2);
00730
00740 JPX←KK←-1;
00750
00760 SEGTOT←(LFILE[0]*6)%256; CLOSE(CHAN2);
00770 ⊃ OUTSTR(FILEI&" "&CVS(SEGTOT)&" ");
00780
00790 FILEP←FILEO[1 TO 3]&FILEQ&".SYN[SYN,ALS]";
00800 CLOSE(CHAN5); OPEN(CHAN5,"DSK",'14,0,2,0,0,0);
00810 ENTER(CHAN5,FILEP,0);
00820 OUTSTR("File "&FILEP&" has been opened");
00830 ARRYOUT(CHAN5,LFILE[0],'200); ⊂ Write header;
00840 OUTSTR(" and header information written."&CRLF);
00850
00860 READ2←READT;
00870 READTT←SCAN(READ2,16,J)&"P[PIT,NJM]";
00880 ⊂ OUTSTR(READTT&CRLF);
00890 CLOSE(CHAN3); OPEN(CHAN3,"DSK",'10,10,0,0,0,EOFT);
00900 LOOKUP(CHAN3,READTT,ER); TFILE←READTT;
00910 IF ER THEN BEGIN
00920 OUTSTR("No .P data (S to start over, space bar to ignore) ");
00930 IF (READ1←INCHRW)="S" THEN GOTO STARTP ELSE BEGIN
00940 BUFTT[0]←'77777; BUFTT[1]←'377777700000;ITT←0; JTT←'3777777;
00950 CLRBUF; END; END;
00960
00970 FOR I←0 STEP 1 UNTIL 8 DO FVAL[I]←0;
00980 DTTTIN;
00990 FVAL[6]←BUFTT[0]; FVAL[3]←(FVAL[6] LSH -15)-(SEGIN-4)*128;KTT←0;
01000
01010
01020
01030
01040 ⊂ Begin "GET";
01050
01060 WHILE TRUE DO BEGIN "GET"
01070
01080 FX←1;
01090
01100 ⊂ OUTSTR("JTT="&CVS(JTT)&TB&"J="&CVS(J)&CRLF);
01110 IF JJ<SEGIN THEN IF EOF≠0 THEN DONE "GET" ELSE DATAIN;
01120
01130 ⊂ OUTSTR("JJ="&CVS(JTT)&TB&"J="&CVS(J)&"before DTTTIN");
01140 IF JTT<(SEGIN-1)*128 THEN DTTTIN;
01150 ⊂ OUTSTR(" and after JTT="&CVS(JTT)&CRLF);
01160
01170 ⊂ FVAL ASSIGNMENTS
01180 [1] DELTA FOR FIRST MARKER
01190 [2] DELTA FOR SECOND MARKER
01200 [3] DELTA FOR THIRD MARKER
01210 [4] PULSE DATE FOR FIRST MARKER
01220 [5] PULSE DATA FOR SECOND MARKER
01230 [6] PULSE DATA FOR THIRD MARKER;
01240
01250
01260 FVAL[1]←FVAL[2]; NEW[NX]←FVAL[4]←FVAL[5]; NX←NX+1;
01270
01280 ⊂ OUTSTR(CVS(FVAL[1])&TB&CVS(FVAL[2])&TB&CVS(FVAL[3])&
01290 TB&CVS(FVAL[4] LSH -15)&
01300 " "&CVS(FVAL[5] LSH -15)&" "&CVS(FVAL[6] LSH -15)&CRLF);
01310 WHILE FVAL[1]>127 DO BEGIN
01320 IF SEGIN≥JJ THEN IF EOF≠0 THEN DONE "GET" ELSE DATAIN;
01330 FOR Q←0 STEP 1 UNTIL 383 DO D[Q]←D[Q+128];
01340 FOR Q←384 STEP 1 UNTIL 511 DO BEGIN
01350 VAL←ILDB(POINTX); IF VAL>2047 THEN VAL←VAL-4096;
01360 D[Q]←VAL; END; SEGIN←SEGIN+1;
01370 FVAL[1]←FVAL[1]-128; FVAL[3]←FVAL[3]-128; END;
01380
01390 IF (FVAL[3]-FVAL[1])>256 THEN BEGIN
01400 FVAL[2]←FVAL[1]+256;
01410 FVAL[5]←(FVAL[4] LAND '377777700000)+'40000000; END
01420 ELSE BEGIN FVAL[2]←FVAL[3]; FVAL[5]←FVAL[6];
01430 KTT←KTT+1; IF KTT≥512 THEN DTTTIN;
01440 FVAL[6]←BUFTT[KTT];
01450 FVAL[3]←(FVAL[6] LSH -15)-(SEGIN-4)*128;END;
01460
01470 ⊂ OUTSTR(CRLF&CVS(SEGIN)&TB&CVS(FVAL[1])&TB&CVS(FVAL[2])&TB&CVS(FVAL[3])&TB&
01480 CVS(FVAL[4] LSH -15)&
01490 " "&CVS(FVAL[5] LSH -15)&" "&CVS(FVAL[6] LSH -15)&TB&TB);
01500
01510
01520 WHILE JPX+KK<(FVAL[4] LSH -15) DO BEGIN
01530 IF (LFILE[LFX]=0) THEN DONE; IF LFX>'177 THEN DONE;
01540 JPX←(LDB(POINT(14,LFILE[LFX],27))-1)*128;
01550 KK←(LDB(POINT(8,LFILE[LFX],35))-1)*128;
01560 L←LFILE[LFX] LAND '777760000000;
01570 LFX←LFX+1; END;
01580 IF JPX<(FVAL[5] LSH -15) THEN OUTSTR(CVSTR(L)) ELSE OUTSTR(" ");
01590
01600 R←R+1; OUTSTR(CVS(FVAL[4] LSH -15)&TB); IF (R MOD 10)=9 THEN OUTSTR(CRLF);
01610
01620 FORM(1);
01630 ⊂ PREPARE;
01640
01650 JP←JP-1; READ1←INCHRS;
01660 IF (READ1=" ")∨(JP=0) THEN BEGIN "SHOW"
01670 TYPLOC(512,170); DPYSET(DPYBUF);
01680 OUTSTR(CRLF&"File "&FILEN&CRLF);
01690 OUTSTR(CRLF&"Data for interval from "&CVS(FVAL[4] LSH -15)
01700 &" to "&CVS(FVAL[5] LSH -15));
01710 FOR Q←0 STEP 1 UNTIL 126 DO IF L=SYMBOL[Q] THEN DONE;
01720 IF JPX>(FVAL[5] LSH -15) THEN OUTSTR(" is undesignated."&crlf)
01730 else BEGIN
01740 OUTSTR(" is designated as the phone "&CVSTR(L));OUTSTR(CRLF);
01750 IF Q<127 THEN OUTSTR(TB&" as in "&SAMPLE[Q]&CRLF); END;
01760 AIVECT(-599,0);MARK;
01770 AIVECT(-599,-340); RARDIS;
01780 DPYOUT(0);PTOCHW(0,'10120);
01790 OUTSTR("Type P for XGP copy file or type next command.");
01800 ⊂ FOR QQ←4 STEP 1 UNTIL 4095 DO IF DPYBUF[QQ] =1 THEN DONE;
01810 ⊂ OUTSTR("DPYBUF filled to "&CVS(QQ)&CRLF);
01820
01830 READ1←INCHRW;
01840 WHILE (READ1="W")∨(READ1="w") DO BEGIN DPYOUT(0) ;
01850 PTOCHW(0,'10120);READ1←INCHRW; END;
01860 IF (READ1="P")∨(READ1="p") THEN BEGIN CALCOMP("PLOTX",DPYBUF);
01870 OUTSTR("EX DPYXGP[X,ALS] plots PLOTX.GRF on the XGP. Next command please."&CRLF);
01880 READ1←INCHRW; END;
01890 K←CVASC(READ1); OPT1←0;
01900
01910 IF K≥CVASC("+") THEN IF K≤CVASC("9") THEN BEGIN
01920 JP←CVD(READ1&INCHWL);END;
01930 OUTSTR(CR);
01940 IF READ1=" " THEN JP←10000;
01950 IF(READ1="F")∨(READ1="f") THEN JP←-1;
01960
01970 IF (READ1='15)∨(READ1='12) THEN BEGIN JP←1; CLRBUF; END;
01980
01990 TOFORM:
02000 IF (READ1="S")∨(READ1="s") THEN JP←JP+1;
02010 IF (READ1="E")∨(READ1="e") THEN GOTO STOPP;
02020 PTOCHW(0,'10103); CLRBUF; TYPLOC(512,-170); PTOCHW(0,'10120);
02030 END "SHOW";
02040
02050
02060 END "GET";
02070 CLOSE(CHAN1); CLOSE(CHAN3);
02080 ARRYOUT(CHAN5,NEW[0],512);CLOSE(CHAN5);NX←0;
02090 IF JP<0 THEN DONE;
02100 END "FILEREAD";
02110
02120 OUTSTR("Data are exhausted"&CRLF&LF); GOTO STARTP;
02130 STOPP: PTOCHW(0,'10103); PTOCHW(0,'10120);
02140
02150 END "FIX";
02160